home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / PERL / PERLY.Y < prev   
Text File  |  1992-01-05  |  22KB  |  829 lines
  1. /* $RCSfile: perly.y,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:17:38 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    perly.y,v $
  9.  * Revision 4.0.1.2  91/11/05  18:17:38  lwall
  10.  * patch11: extra comma at end of list is now allowed in more places (Hi, Felix!)
  11.  * patch11: once-thru blocks didn't display right in the debugger
  12.  * patch11: debugger got confused over nested subroutine definitions
  13.  * 
  14.  * Revision 4.0.1.1  91/06/07  11:42:34  lwall
  15.  * patch4: new copyright notice
  16.  * 
  17.  * Revision 4.0  91/03/20  01:38:40  lwall
  18.  * 4.0 baseline.
  19.  * 
  20.  */
  21.  
  22. %{
  23. #include "INTERN.h"
  24. #include "perl.h"
  25.  
  26. /*SUPPRESS 530*/
  27. /*SUPPRESS 593*/
  28. /*SUPPRESS 595*/
  29.  
  30. STAB *scrstab;
  31. ARG *arg4;    /* rarely used arguments to make_op() */
  32. ARG *arg5;
  33.  
  34. %}
  35.  
  36. %start prog
  37.  
  38. %union {
  39.     int    ival;
  40.     char *cval;
  41.     ARG *arg;
  42.     CMD *cmdval;
  43.     struct compcmd compval;
  44.     STAB *stabval;
  45.     FCMD *formval;
  46. }
  47.  
  48. %token <ival> '{' ')'
  49.  
  50. %token <cval> WORD
  51. %token <ival> APPEND OPEN SSELECT LOOPEX
  52. %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
  53. %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
  54. %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
  55. %token <ival> FUNC0 FUNC1 FUNC2 FUNC2x FUNC3 FUNC4 FUNC5 HSHFUN HSHFUN3
  56. %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
  57. %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER
  58. %token <formval> FORMLIST
  59. %token <stabval> REG ARYLEN ARY HSH STAR
  60. %token <arg> SUBST PATTERN
  61. %token <arg> RSTRING TRANS
  62.  
  63. %type <ival> prog decl format remember crp
  64. %type <cmdval> block lineseq line loop cond sideff nexpr else
  65. %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
  66. %type <arg> texpr listop bareword
  67. %type <cval> label
  68. %type <compval> compblock
  69.  
  70. %nonassoc <ival> LISTOP
  71. %left ','
  72. %right '='
  73. %right '?' ':'
  74. %nonassoc DOTDOT
  75. %left OROR
  76. %left ANDAND
  77. %left '|' '^'
  78. %left '&'
  79. %nonassoc EQOP
  80. %nonassoc RELOP
  81. %nonassoc <ival> UNIOP
  82. %nonassoc FILETEST
  83. %left LS RS
  84. %left ADDOP
  85. %left MULOP
  86. %left MATCH NMATCH 
  87. %right '!' '~' UMINUS
  88. %right POW
  89. %nonassoc INC DEC
  90. %left '('
  91.  
  92. %% /* RULES */
  93.  
  94. prog    :    /* NULL */
  95.         {
  96. #if defined(YYDEBUG) && defined(DEBUGGING)
  97.             yydebug = (debug & 1);
  98. #endif
  99.         }
  100.     /*CONTINUED*/    lineseq
  101.             { if (in_eval)
  102.                 eval_root = block_head($2);
  103.                 else
  104.                 main_root = block_head($2); }
  105.     ;
  106.  
  107. compblock:    block CONTINUE block
  108.             { $$.comp_true = $1; $$.comp_alt = $3; }
  109.     |    block else
  110.             { $$.comp_true = $1; $$.comp_alt = $2; }
  111.     ;
  112.  
  113. else    :    /* NULL */
  114.             { $$ = Nullcmd; }
  115.     |    ELSE block
  116.             { $$ = $2; }
  117.     |    ELSIF '(' expr ')' compblock
  118.             { cmdline = $1;
  119.                 $$ = make_ccmd(C_ELSIF,$3,$5); }
  120.     ;
  121.  
  122. block    :    '{' remember lineseq '}'
  123.             { $$ = block_head($3);
  124.               if (cmdline > $1)
  125.                   cmdline = $1;
  126.               if (savestack->ary_fill > $2)
  127.                 restorelist($2); }
  128.     ;
  129.  
  130. remember:    /* NULL */    /* in case they push a package name */
  131.             { $$ = savestack->ary_fill; }
  132.     ;
  133.  
  134. lineseq    :    /* NULL */
  135.             { $$ = Nullcmd; }
  136.     |    lineseq line
  137.             { $$ = append_line($1,$2); }
  138.     ;
  139.  
  140. line    :    decl
  141.             { $$ = Nullcmd; }
  142.     |    label cond
  143.             { $$ = add_label($1,$2); }
  144.     |    loop    /* loops add their own labels */
  145.     |    label ';'
  146.             { if ($1 != Nullch) {
  147.                   $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
  148.                   Nullarg, Nullarg) );
  149.                 }
  150.                 else {
  151.                   $$ = Nullcmd;
  152.                   cmdline = NOLINE;
  153.                 } }
  154.     |    label sideff ';'
  155.             { $$ = add_label($1,$2); }
  156.     ;
  157.  
  158. sideff    :    error
  159.             { $$ = Nullcmd; }
  160.     |    expr
  161.             { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
  162.     |    expr IF expr
  163.             { $$ = addcond(
  164.                    make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
  165.     |    expr UNLESS expr
  166.             { $$ = addcond(invert(
  167.                    make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
  168.     |    expr WHILE expr
  169.             { $$ = addloop(
  170.                    make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
  171.     |    expr UNTIL expr
  172.             { $$ = addloop(invert(
  173.                    make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
  174.     ;
  175.  
  176. cond    :    IF '(' expr ')' compblock
  177.             { cmdline = $1;
  178.                 $$ = make_icmd(C_IF,$3,$5); }
  179.     |    UNLESS '(' expr ')' compblock
  180.             { cmdline = $1;
  181.                 $$ = invert(make_icmd(C_IF,$3,$5)); }
  182.     |    IF block compblock
  183.             { cmdline = $1;
  184.                 $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
  185.     |    UNLESS block compblock
  186.             { cmdline = $1;
  187.                 $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
  188.     ;
  189.  
  190. loop    :    label WHILE '(' texpr ')' compblock
  191.             { cmdline = $2;
  192.                 $$ = wopt(add_label($1,
  193.                 make_ccmd(C_WHILE,$4,$6) )); }
  194.     |    label UNTIL '(' expr ')' compblock
  195.             { cmdline = $2;
  196.                 $$ = wopt(add_label($1,
  197.                 invert(make_ccmd(C_WHILE,$4,$6)) )); }
  198.     |    label WHILE block compblock
  199.             { cmdline = $2;
  200.                 $$ = wopt(add_label($1,
  201.                 make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); }
  202.     |    label UNTIL block compblock
  203.             { cmdline = $2;
  204.                 $$ = wopt(add_label($1,
  205.                 invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
  206.     |    label FOR REG '(' expr crp compblock
  207.             { cmdline = $2;
  208.                 /*
  209.                  * The following gobbledygook catches EXPRs that
  210.                  * aren't explicit array refs and translates
  211.                  *        foreach VAR (EXPR) {
  212.                  * into
  213.                  *        @ary = EXPR;
  214.                  *        foreach VAR (@ary) {
  215.                  * where @ary is a hidden array made by genstab().
  216.                  * (Note that @ary may become a local array if
  217.                  * it is determined that it might be called
  218.                  * recursively.  See cmd_tosave().)
  219.                  */
  220.                 if ($5->arg_type != O_ARRAY) {
  221.                 scrstab = aadd(genstab());
  222.                 $$ = append_line(
  223.                     make_acmd(C_EXPR, Nullstab,
  224.                       l(make_op(O_ASSIGN,2,
  225.                     listish(make_op(O_ARRAY, 1,
  226.                       stab2arg(A_STAB,scrstab),
  227.                       Nullarg,Nullarg )),
  228.                     listish(make_list($5)),
  229.                     Nullarg)),
  230.                       Nullarg),
  231.                     wopt(over($3,add_label($1,
  232.                       make_ccmd(C_WHILE,
  233.                     make_op(O_ARRAY, 1,
  234.                       stab2arg(A_STAB,scrstab),
  235.                       Nullarg,Nullarg ),
  236.                     $7)))));
  237.                 $$->c_line = $2;
  238.                 $$->c_head->c_line = $2;
  239.                 }
  240.                 else {
  241.                 $$ = wopt(over($3,add_label($1,
  242.                 make_ccmd(C_WHILE,$5,$7) )));
  243.                 }
  244.             }
  245.     |    label FOR '(' expr crp compblock
  246.             { cmdline = $2;
  247.                 if ($4->arg_type != O_ARRAY) {
  248.                 scrstab = aadd(genstab());
  249.                 $$ = append_line(
  250.                     make_acmd(C_EXPR, Nullstab,
  251.                       l(make_op(O_ASSIGN,2,
  252.                     listish(make_op(O_ARRAY, 1,
  253.                       stab2arg(A_STAB,scrstab),
  254.                       Nullarg,Nullarg )),
  255.                     listish(make_list($4)),
  256.                     Nullarg)),
  257.                       Nullarg),
  258.                     wopt(over(defstab,add_label($1,
  259.                       make_ccmd(C_WHILE,
  260.                     make_op(O_ARRAY, 1,
  261.                       stab2arg(A_STAB,scrstab),
  262.                       Nullarg,Nullarg ),
  263.                     $6)))));
  264.                 $$->c_line = $2;
  265.                 $$->c_head->c_line = $2;
  266.                 }
  267.                 else {    /* lisp, anyone? */
  268.                 $$ = wopt(over(defstab,add_label($1,
  269.                 make_ccmd(C_WHILE,$4,$6) )));
  270.                 }
  271.             }
  272.     |    label FOR '(' nexpr ';' texpr ';' nexpr ')' block
  273.             /* basically fake up an initialize-while lineseq */
  274.             {   yyval.compval.comp_true = $10;
  275.                 yyval.compval.comp_alt = $8;
  276.                 cmdline = $2;
  277.                 $$ = append_line($4,wopt(add_label($1,
  278.                 make_ccmd(C_WHILE,$6,yyval.compval) ))); }
  279.     |    label compblock    /* a block is a loop that happens once */
  280.             { $$ = add_label($1,make_ccmd(C_BLOCK,Nullarg,$2)); }
  281.     ;
  282.  
  283. nexpr    :    /* NULL */
  284.             { $$ = Nullcmd; }
  285.     |    sideff
  286.     ;
  287.  
  288. texpr    :    /* NULL means true */
  289.             { (void)scanstr("1"); $$ = yylval.arg; }
  290.     |    expr
  291.     ;
  292.  
  293. label    :    /* empty */
  294.             { $$ = Nullch; }
  295.     |    WORD ':'
  296.     ;
  297.  
  298. decl    :    format
  299.             { $$ = 0; }
  300.     |    subrout
  301.             { $$ = 0; }
  302.     |    package
  303.             { $$ = 0; }
  304.     ;
  305.  
  306. format    :    FORMAT WORD '=' FORMLIST
  307.             { if (strEQ($2,"stdout"))
  308.                 make_form(stabent("STDOUT",TRUE),$4);
  309.               else if (strEQ($2,"stderr"))
  310.                 make_form(stabent("STDERR",TRUE),$4);
  311.               else
  312.                 make_form(stabent($2,TRUE),$4);
  313.               Safefree($2); $2 = Nullch; }
  314.     |    FORMAT '=' FORMLIST
  315.             { make_form(stabent("STDOUT",TRUE),$3); }
  316.     ;
  317.  
  318. subrout    :    SUB WORD block
  319.             { make_sub($2,$3);
  320.               cmdline = NOLINE;
  321.               if (savestack->ary_fill > $1)
  322.                 restorelist($1); }
  323.     ;
  324.  
  325. package :    PACKAGE WORD ';'
  326.             { char tmpbuf[256];
  327.               STAB *tmpstab;
  328.  
  329.               savehptr(&curstash);
  330.               saveitem(curstname);
  331.               str_set(curstname,$2);
  332.               sprintf(tmpbuf,"'_%s",$2);
  333.               tmpstab = stabent(tmpbuf,TRUE);
  334.               if (!stab_xhash(tmpstab))
  335.                   stab_xhash(tmpstab) = hnew(0);
  336.               curstash = stab_xhash(tmpstab);
  337.               if (!curstash->tbl_name)
  338.                   curstash->tbl_name = savestr($2);
  339.               curstash->tbl_coeffsize = 0;
  340.               Safefree($2); $2 = Nullch;
  341.               cmdline = NOLINE;
  342.             }
  343.     ;
  344.  
  345. cexpr    :    ',' expr
  346.             { $$ = $2; }
  347.     ;
  348.  
  349. expr    :    expr ',' sexpr
  350.             { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
  351.     |    sexpr
  352.     ;
  353.  
  354. csexpr    :    ',' sexpr
  355.             { $$ = $2; }
  356.     ;
  357.  
  358. sexpr    :    sexpr '=' sexpr
  359.             {   $1 = listish($1);
  360.                 if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
  361.                 $1->arg_type = O_ITEM;    /* a local() */
  362.                 if ($1->arg_type == O_LIST)
  363.                 $3 = listish($3);
  364.                 $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
  365.     |    sexpr POW '=' sexpr
  366.             { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
  367.     |    sexpr MULOP '=' sexpr
  368.             { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
  369.     |    sexpr ADDOP '=' sexpr
  370.             { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
  371.     |    sexpr LS '=' sexpr
  372.             { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
  373.     |    sexpr RS '=' sexpr
  374.             { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
  375.     |    sexpr '&' '=' sexpr
  376.             { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
  377.     |    sexpr '^' '=' sexpr
  378.             { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
  379.     |    sexpr '|' '=' sexpr
  380.             { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
  381.  
  382.  
  383.     |    sexpr POW sexpr
  384.             { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
  385.     |    sexpr MULOP sexpr
  386.             { if ($2 == O_REPEAT)
  387.                   $1 = listish($1);
  388.                 $$ = make_op($2, 2, $1, $3, Nullarg);
  389.                 if ($2 == O_REPEAT) {
  390.                 if ($$[1].arg_type != A_EXPR ||
  391.                   $$[1].arg_ptr.arg_arg->arg_type != O_LIST)
  392.                     $$[1].arg_flags &= ~AF_ARYOK;
  393.                 } }
  394.     |    sexpr ADDOP sexpr
  395.             { $$ = make_op($2, 2, $1, $3, Nullarg); }
  396.     |    sexpr LS sexpr
  397.             { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
  398.     |    sexpr RS sexpr
  399.             { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
  400.     |    sexpr RELOP sexpr
  401.             { $$ = make_op($2, 2, $1, $3, Nullarg); }
  402.     |    sexpr EQOP sexpr
  403.             { $$ = make_op($2, 2, $1, $3, Nullarg); }
  404.     |    sexpr '&' sexpr
  405.             { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
  406.     |    sexpr '^' sexpr
  407.             { $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
  408.     |    sexpr '|' sexpr
  409.             { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
  410.     |    sexpr DOTDOT sexpr
  411.             { arg4 = Nullarg;
  412.               $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg); }
  413.     |    sexpr ANDAND sexpr
  414.             { $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
  415.     |    sexpr OROR sexpr
  416.             { $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
  417.     |    sexpr '?' sexpr ':' sexpr
  418.             { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
  419.     |    sexpr MATCH sexpr
  420.             { $$ = mod_match(O_MATCH, $1, $3); }
  421.     |    sexpr NMATCH sexpr
  422.             { $$ = mod_match(O_NMATCH, $1, $3); }
  423.     |    term
  424.             { $$ = $1; }
  425.     ;
  426.  
  427. term    :    '-' term %prec UMINUS
  428.             { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
  429.     |    '+' term %prec UMINUS
  430.             { $$ = $2; }
  431.     |    '!' term
  432.             { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
  433.     |    '~' term
  434.             { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
  435.     |    term INC
  436.             { $$ = addflags(1, AF_POST|AF_UP,
  437.                 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
  438.     |    term DEC
  439.             { $$ = addflags(1, AF_POST,
  440.                 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
  441.     |    INC term
  442.             { $$ = addflags(1, AF_PRE|AF_UP,
  443.                 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
  444.     |    DEC term
  445.             { $$ = addflags(1, AF_PRE,
  446.                 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
  447.     |    FILETEST WORD
  448.             { opargs[$1] = 0;    /* force it special */
  449.                 $$ = make_op($1, 1,
  450.                 stab2arg(A_STAB,stabent($2,TRUE)),
  451.                 Nullarg, Nullarg);
  452.             }
  453.     |    FILETEST sexpr
  454.             { opargs[$1] = 1;
  455.                 $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
  456.     |    FILETEST
  457.             { opargs[$1] = ($1 != O_FTTTY);
  458.                 $$ = make_op($1, 1,
  459.                 stab2arg(A_STAB,
  460.                   $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
  461.                 Nullarg, Nullarg); }
  462.     |    LOCAL '(' expr crp
  463.             { $$ = l(localize(make_op(O_ASSIGN, 1,
  464.                 localize(listish(make_list($3))),
  465.                 Nullarg,Nullarg))); }
  466.     |    '(' expr crp
  467.             { $$ = make_list($2); }
  468.     |    '(' ')'
  469.             { $$ = make_list(Nullarg); }
  470.     |    DO sexpr    %prec FILETEST
  471.             { $$ = make_op(O_DOFILE,2,$2,Nullarg,Nullarg);
  472.               allstabs = TRUE;}
  473.     |    DO block    %prec '('
  474.             { $$ = cmd_to_arg($2); }
  475.     |    REG    %prec '('
  476.             { $$ = stab2arg(A_STAB,$1); }
  477.     |    STAR    %prec '('
  478.             { $$ = stab2arg(A_STAR,$1); }
  479.     |    REG '[' expr ']'    %prec '('
  480.             { $$ = make_op(O_AELEM, 2,
  481.                 stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
  482.     |    HSH     %prec '('
  483.             { $$ = make_op(O_HASH, 1,
  484.                 stab2arg(A_STAB,$1),
  485.                 Nullarg, Nullarg); }
  486.     |    ARY     %prec '('
  487.             { $$ = make_op(O_ARRAY, 1,
  488.                 stab2arg(A_STAB,$1),
  489.                 Nullarg, Nullarg); }
  490.     |    REG '{' expr '}'    %prec '('
  491.             { $$ = make_op(O_HELEM, 2,
  492.                 stab2arg(A_STAB,hadd($1)),
  493.                 jmaybe($3),
  494.                 Nullarg); }
  495.     |    '(' expr crp '[' expr ']'    %prec '('
  496.             { $$ = make_op(O_LSLICE, 3,
  497.                 Nullarg,
  498.                 listish(make_list($5)),
  499.                 listish(make_list($2))); }
  500.     |    '(' ')' '[' expr ']'    %prec '('
  501.             { $$ = make_op(O_LSLICE, 3,
  502.                 Nullarg,
  503.                 listish(make_list($4)),
  504.                 Nullarg); }
  505.     |    ARY '[' expr ']'    %prec '('
  506.             { $$ = make_op(O_ASLICE, 2,
  507.                 stab2arg(A_STAB,aadd($1)),
  508.                 listish(make_list($3)),
  509.                 Nullarg); }
  510.     |    ARY '{' expr '}'    %prec '('
  511.             { $$ = make_op(O_HSLICE, 2,
  512.                 stab2arg(A_STAB,hadd($1)),
  513.                 listish(make_list($3)),
  514.                 Nullarg); }
  515.     |    DELETE REG '{' expr '}'    %prec '('
  516.             { $$ = make_op(O_DELETE, 2,
  517.                 stab2arg(A_STAB,hadd($2)),
  518.                 jmaybe($4),
  519.                 Nullarg); }
  520.     |    ARYLEN    %prec '('
  521.             { $$ = stab2arg(A_ARYLEN,$1); }
  522.     |    RSTRING    %prec '('
  523.             { $$ = $1; }
  524.     |    PATTERN    %prec '('
  525.             { $$ = $1; }
  526.     |    SUBST    %prec '('
  527.             { $$ = $1; }
  528.     |    TRANS    %prec '('
  529.             { $$ = $1; }
  530.     |    DO WORD '(' expr crp
  531.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  532.                 stab2arg(A_WORD,stabent($2,MULTI)),
  533.                 make_list($4),
  534.                 Nullarg); Safefree($2); $2 = Nullch;
  535.                 $$->arg_flags |= AF_DEPR; }
  536.     |    AMPER WORD '(' expr crp
  537.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  538.                 stab2arg(A_WORD,stabent($2,MULTI)),
  539.                 make_list($4),
  540.                 Nullarg); Safefree($2); $2 = Nullch; }
  541.     |    DO WORD '(' ')'
  542.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  543.                 stab2arg(A_WORD,stabent($2,MULTI)),
  544.                 make_list(Nullarg),
  545.                 Nullarg);
  546.                 $$->arg_flags |= AF_DEPR; }
  547.     |    AMPER WORD '(' ')'
  548.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  549.                 stab2arg(A_WORD,stabent($2,MULTI)),
  550.                 make_list(Nullarg),
  551.                 Nullarg); }
  552.     |    AMPER WORD
  553.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  554.                 stab2arg(A_WORD,stabent($2,MULTI)),
  555.                 Nullarg,
  556.                 Nullarg); }
  557.     |    DO REG '(' expr crp
  558.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  559.                 stab2arg(A_STAB,$2),
  560.                 make_list($4),
  561.                 Nullarg);
  562.                 $$->arg_flags |= AF_DEPR; }
  563.     |    AMPER REG '(' expr crp
  564.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  565.                 stab2arg(A_STAB,$2),
  566.                 make_list($4),
  567.                 Nullarg); }
  568.     |    DO REG '(' ')'
  569.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  570.                 stab2arg(A_STAB,$2),
  571.                 make_list(Nullarg),
  572.                 Nullarg);
  573.                 $$->arg_flags |= AF_DEPR; }
  574.     |    AMPER REG '(' ')'
  575.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  576.                 stab2arg(A_STAB,$2),
  577.                 make_list(Nullarg),
  578.                 Nullarg); }
  579.     |    AMPER REG
  580.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  581.                 stab2arg(A_STAB,$2),
  582.                 Nullarg,
  583.                 Nullarg); }
  584.     |    LOOPEX
  585.             { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
  586.     |    LOOPEX WORD
  587.             { $$ = make_op($1,1,cval_to_arg($2),
  588.                 Nullarg,Nullarg); }
  589.     |    UNIOP
  590.             { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
  591.     |    UNIOP block
  592.             { $$ = make_op($1,1,cmd_to_arg($2),Nullarg,Nullarg); }
  593.     |    UNIOP sexpr
  594.             { $$ = make_op($1,1,$2,Nullarg,Nullarg); }
  595.     |    SSELECT
  596.             { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
  597.     |    SSELECT  WORD
  598.             { $$ = make_op(O_SELECT, 1,
  599.                 stab2arg(A_WORD,stabent($2,TRUE)),
  600.                 Nullarg,
  601.                 Nullarg);
  602.                 Safefree($2); $2 = Nullch; }
  603.     |    SSELECT '(' handle ')'
  604.             { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
  605.     |    SSELECT '(' sexpr csexpr csexpr csexpr ')'
  606.             { arg4 = $6;
  607.               $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
  608.     |    OPEN WORD    %prec '('
  609.             { $$ = make_op(O_OPEN, 2,
  610.                 stab2arg(A_WORD,stabent($2,TRUE)),
  611.                 stab2arg(A_STAB,stabent($2,TRUE)),
  612.                 Nullarg); }
  613.     |    OPEN '(' WORD ')'
  614.             { $$ = make_op(O_OPEN, 2,
  615.                 stab2arg(A_WORD,stabent($3,TRUE)),
  616.                 stab2arg(A_STAB,stabent($3,TRUE)),
  617.                 Nullarg); }
  618.     |    OPEN '(' handle cexpr ')'
  619.             { $$ = make_op(O_OPEN, 2,
  620.                 $3,
  621.                 $4, Nullarg); }
  622.     |    FILOP '(' handle ')'
  623.             { $$ = make_op($1, 1,
  624.                 $3,
  625.                 Nullarg, Nullarg); }
  626.     |    FILOP WORD
  627.             { $$ = make_op($1, 1,
  628.                 stab2arg(A_WORD,stabent($2,TRUE)),
  629.                 Nullarg, Nullarg);
  630.               Safefree($2); $2 = Nullch; }
  631.     |    FILOP REG
  632.             { $$ = make_op($1, 1,
  633.                 stab2arg(A_STAB,$2),
  634.                 Nullarg, Nullarg); }
  635.     |    FILOP '(' ')'
  636.             { $$ = make_op($1, 1,
  637.                 stab2arg(A_WORD,Nullstab),
  638.                 Nullarg, Nullarg); }
  639.     |    FILOP    %prec '('
  640.             { $$ = make_op($1, 0,
  641.                 Nullarg, Nullarg, Nullarg); }
  642.     |    FILOP2 '(' handle cexpr ')'
  643.             { $$ = make_op($1, 2, $3, $4, Nullarg); }
  644.     |    FILOP3 '(' handle csexpr cexpr ')'
  645.             { $$ = make_op($1, 3, $3, $4, make_list($5)); }
  646.     |    FILOP22 '(' handle ',' handle ')'
  647.             { $$ = make_op($1, 2, $3, $5, Nullarg); }
  648.     |    FILOP4 '(' handle csexpr csexpr cexpr ')'
  649.             { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
  650.     |    FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
  651.             { arg4 = $7; arg5 = $8;
  652.               $$ = make_op($1, 5, $3, $5, $6); }
  653.     |    PUSH '(' aryword ',' expr crp
  654.             { $$ = make_op($1, 2,
  655.                 $3,
  656.                 make_list($5),
  657.                 Nullarg); }
  658.     |    POP aryword    %prec '('
  659.             { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
  660.     |    POP '(' aryword ')'
  661.             { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
  662.     |    SHIFT aryword    %prec '('
  663.             { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
  664.     |    SHIFT '(' aryword ')'
  665.             { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
  666.     |    SHIFT    %prec '('
  667.             { $$ = make_op(O_SHIFT, 1,
  668.                 stab2arg(A_STAB,
  669.                   aadd(stabent(subline ? "_" : "ARGV", TRUE))),
  670.                 Nullarg, Nullarg); }
  671.     |    SPLIT    %prec '('
  672.             {   static char p[]="/\\s+/";
  673.                 char *oldend = bufend;
  674.                 ARG *oldarg = yylval.arg;
  675.                 
  676.                 bufend=p+5;
  677.                 (void)scanpat(p);
  678.                 bufend=oldend;
  679.                 $$ = make_split(defstab,yylval.arg,Nullarg);
  680.                 yylval.arg = oldarg; }
  681.     |    SPLIT '(' sexpr csexpr csexpr ')'
  682.             { $$ = mod_match(O_MATCH, $4,
  683.               make_split(defstab,$3,$5));}
  684.     |    SPLIT '(' sexpr csexpr ')'
  685.             { $$ = mod_match(O_MATCH, $4,
  686.               make_split(defstab,$3,Nullarg) ); }
  687.     |    SPLIT '(' sexpr ')'
  688.             { $$ = mod_match(O_MATCH,
  689.                 stab2arg(A_STAB,defstab),
  690.                 make_split(defstab,$3,Nullarg) ); }
  691.     |    FLIST2 '(' sexpr cexpr ')'
  692.             { $$ = make_op($1, 2,
  693.                 $3,
  694.                 listish(make_list($4)),
  695.                 Nullarg); }
  696.     |    FLIST '(' expr crp
  697.             { $$ = make_op($1, 1,
  698.                 make_list($3),
  699.                 Nullarg,
  700.                 Nullarg); }
  701.     |    LVALFUN sexpr    %prec '('
  702.             { $$ = l(make_op($1, 1, fixl($1,$2),
  703.                 Nullarg, Nullarg)); }
  704.     |    LVALFUN
  705.             { $$ = l(make_op($1, 1,
  706.                 stab2arg(A_STAB,defstab),
  707.                 Nullarg, Nullarg)); }
  708.     |    FUNC0
  709.             { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
  710.     |    FUNC0 '(' ')'
  711.             { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
  712.     |    FUNC1 '(' ')'
  713.             { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
  714.     |    FUNC1 '(' expr ')'
  715.             { $$ = make_op($1, 1, $3, Nullarg, Nullarg); }
  716.     |    FUNC2 '(' sexpr cexpr ')'
  717.             { $$ = make_op($1, 2, $3, $4, Nullarg);
  718.                 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
  719.                 fbmcompile($$[2].arg_ptr.arg_str,0); }
  720.     |    FUNC2x '(' sexpr csexpr ')'
  721.             { $$ = make_op($1, 2, $3, $4, Nullarg);
  722.                 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
  723.                 fbmcompile($$[2].arg_ptr.arg_str,0); }
  724.     |    FUNC2x '(' sexpr csexpr cexpr ')'
  725.             { $$ = make_op($1, 3, $3, $4, $5);
  726.                 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
  727.                 fbmcompile($$[2].arg_ptr.arg_str,0); }
  728.     |    FUNC3 '(' sexpr csexpr cexpr ')'
  729.             { $$ = make_op($1, 3, $3, $4, $5); }
  730.     |    FUNC4 '(' sexpr csexpr csexpr cexpr ')'
  731.             { arg4 = $6;
  732.               $$ = make_op($1, 4, $3, $4, $5); }
  733.     |    FUNC5 '(' sexpr csexpr csexpr csexpr cexpr ')'
  734.             { arg4 = $6; arg5 = $7;
  735.               $$ = make_op($1, 5, $3, $4, $5); }
  736.     |    HSHFUN '(' hshword ')'
  737.             { $$ = make_op($1, 1,
  738.                 $3,
  739.                 Nullarg,
  740.                 Nullarg); }
  741.     |    HSHFUN hshword
  742.             { $$ = make_op($1, 1,
  743.                 $2,
  744.                 Nullarg,
  745.                 Nullarg); }
  746.     |    HSHFUN3 '(' hshword csexpr cexpr ')'
  747.             { $$ = make_op($1, 3, $3, $4, $5); }
  748.     |    bareword
  749.     |    listop
  750.     ;
  751.  
  752. listop    :    LISTOP
  753.             { $$ = make_op($1,2,
  754.                 stab2arg(A_WORD,Nullstab),
  755.                 stab2arg(A_STAB,defstab),
  756.                 Nullarg); }
  757.     |    LISTOP expr
  758.             { $$ = make_op($1,2,
  759.                 stab2arg(A_WORD,Nullstab),
  760.                 maybelistish($1,make_list($2)),
  761.                 Nullarg); }
  762.     |    LISTOP WORD
  763.             { $$ = make_op($1,2,
  764.                 stab2arg(A_WORD,stabent($2,TRUE)),
  765.                 stab2arg(A_STAB,defstab),
  766.                 Nullarg); }
  767.     |    LISTOP WORD expr
  768.             { $$ = make_op($1,2,
  769.                 stab2arg(A_WORD,stabent($2,TRUE)),
  770.                 maybelistish($1,make_list($3)),
  771.                 Nullarg); Safefree($2); $2 = Nullch; }
  772.     |    LISTOP REG expr
  773.             { $$ = make_op($1,2,
  774.                 stab2arg(A_STAB,$2),
  775.                 maybelistish($1,make_list($3)),
  776.                 Nullarg); }
  777.     |    LISTOP block expr
  778.             { $$ = make_op($1,2,
  779.                 cmd_to_arg($2),
  780.                 maybelistish($1,make_list($3)),
  781.                 Nullarg); }
  782.     ;
  783.  
  784. handle    :    WORD
  785.             { $$ = stab2arg(A_WORD,stabent($1,TRUE));
  786.               Safefree($1); $1 = Nullch;}
  787.     |    sexpr
  788.     ;
  789.  
  790. aryword    :    WORD
  791.             { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
  792.                 Safefree($1); $1 = Nullch; }
  793.     |    ARY
  794.             { $$ = stab2arg(A_STAB,$1); }
  795.     ;
  796.  
  797. hshword    :    WORD
  798.             { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
  799.                 Safefree($1); $1 = Nullch; }
  800.     |    HSH
  801.             { $$ = stab2arg(A_STAB,$1); }
  802.     ;
  803.  
  804. crp    :    ',' ')'
  805.             { $$ = 1; }
  806.     |    ')'
  807.             { $$ = 0; }
  808.     ;
  809.  
  810. /*
  811.  * NOTE:  The following entry must stay at the end of the file so that
  812.  * reduce/reduce conflicts resolve to it only if it's the only option.
  813.  */
  814.  
  815. bareword:    WORD
  816.             { char *s;
  817.                 $$ = op_new(1);
  818.                 $$->arg_type = O_ITEM;
  819.                 $$[1].arg_type = A_SINGLE;
  820.                 $$[1].arg_ptr.arg_str = str_make($1,0);
  821.                 for (s = $1; *s && isLOWER(*s); s++) ;
  822.                 if (dowarn && !*s)
  823.                 warn(
  824.                   "\"%s\" may clash with future reserved word",
  825.                   $1 );
  826.             }
  827.         ;
  828. %% /* PROGRAM */
  829.